Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue50/Except/hvyast32.pas

Pascal/Delphi Source File | 1999-09-06 | 9.5 KB | 306 lines

unit HVYAST32;
// Yet-Another-Stack-Tracer, 32-bit version
//
// Loosely based on my 16-bit YAST code published in
// The Delphi Magazine, issue 7.
//
// Description: A general call-back based stack-trace utility.
// Both stack frames based and raw stack tracing is supported.
//
// Written by Hallvard Vassbotn, [e-mail], July 1999
//
interface

uses
  Windows,
  SysUtils;

// The generic stack tracing machinery

const
  MaxBlock = MaxInt-$f;
type
  PBytes  = ^TBytes;
  TBytes  = array[0..MaxBlock div SizeOf(byte)] of byte;
  PDWORDS = ^TDWORDS;
  TDWORDS = array[0..MaxBlock div SizeOf(DWORD)] of DWORD;
  PStackFrame = ^TStackFrame;
  TStackFrame = record
    CallersEBP : DWORD;
    CallerAdr  : DWORD;
  end;
  TStackInfo = record
    CallerAdr  : DWORD;
    Level      : DWORD;
    CallersEBP : DWORD;
    DumpSize   : DWORD;
    ParamSize  : DWORD;
    ParamPtr   : PDWORDS;
    case integer of
     0 : (StackFrame : PStackFrame);
     1 : (DumpPtr    : PBytes);
  end;
  TReportStackFrame = function(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;

procedure TraceStackFrames(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
procedure TraceStackRaw(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);

// Default stack tracer

const
  MaxStackLevels = 50;
type
  TStackInfoArray = array[0..MaxStackLevels-1] of TStackInfo;
var
  StackDump: TStackInfoArray;
  StackDumpCount: integer;

function PhysicalToLogical(Physical: DWORD): DWORD;
function DefaultReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
procedure SaveStackTrace(Raw: boolean; IgnoreLevels: integer; FirstCaller: pointer);

implementation

uses
  HVPEUtils;

{$W-} // This routine should not have a EBP stack frame
function GetEBP: pointer;
// Return the current contents of the EBP register
asm
  MOV EAX, EBP
end;

function GetESP: pointer;
// Return the current contents of the ESP register
asm
  MOV EAX, ESP
end;

function GetStackTop: DWORD;
asm
  // Pick up the top of the stack from the Thread Information Block (TIB)
  // pointed to by the FS segment register.
  //
  // Reference: Matt Pietrek, MSJ, Under the hood, on TIBs:
  // PVOID pvStackUserTop  // 04h Top of user stack
  // http:{msdn.microsoft.com/library/periodic/period96/periodic/msj/F1/D6/S2CE.htm }
  //
  MOV EAX, FS:[4]
end;

var
  TopOfStack : DWORD;
  BaseOfStack: DWORD;
  BaseOfCode : DWORD;
  TopOfCode  : DWORD;

procedure InitGlobalVars;
var
  NTHeader: PImageNTHeaders;
begin
  { Get pointers into the EXE file image }
  if BaseOfCode = 0 then
  begin
    NTHeader := GetImageNtHeader(Pointer(hInstance));
    BaseOfCode := DWord(hInstance) + NTHeader.OptionalHeader.BaseOfCode;
    TopOfCode := BaseOfCode + NTHeader.OptionalHeader.SizeOfCode;
    TopOfStack := GetStackTop;
  end;
end;

function ValidStackAddr(StackAddr: DWORD): boolean;
begin
  Result := (BaseOfStack < StackAddr) and (StackAddr < TopOfStack);
end;

function ValidCodeAddr(CodeAddr: DWORD): boolean;
begin
  Result := (BaseOfCode < CodeAddr) and  (CodeAddr < TopOfCode);
end;

function ValidCallSite(CodeAddr: DWORD): boolean;
// Validate that the code address is a valid code site
//
// Information from Intel Manual 24319102(2).pdf, Download the 6.5 MBs from:
//  http://developer.intel.com/design/pentiumii/manuals/243191.htm
//  Instruction format, Chapter 2 and The CALL instruction: page 3-53, 3-54
var
  CodeDWORD4: DWORD;
  CodeDWORD8: DWORD;
begin
  // First check that the address is within range of our code segment!
  Result := (BaseOfCode < CodeAddr) and  (CodeAddr < TopOfCode);

  // Now check to see if the instruction preceeding the return address
  // could be a valid CALL instruction
  if Result then
  begin
    // Check the instruction prior to the potential call site.
    // We consider it a valid call site if we find a CALL instruction there
    // Check the most common CALL variants first
    CodeDWORD8 := PDWORD(CodeAddr-8)^;
    CodeDWORD4 := PDWORD(CodeAddr-4)^;

    Result :=
          ((CodeDWORD8 and $FF000000) = $E8000000) // 5-byte, CALL [-$1234567]
       or ((CodeDWORD4 and $38FF0000) = $10FF0000) // 2 byte, CALL EAX
       or ((CodeDWORD4 and $0038FF00) = $0010FF00) // 3 byte, CALL [EBP+0x8]
       or ((CodeDWORD4 and $000038FF) = $000010FF) // 4 byte, CALL ??
       or ((CodeDWORD8 and $38FF0000) = $10FF0000) // 6-byte, CALL ??
       or ((CodeDWORD8 and $0038FF00) = $0010FF00) // 7-byte, CALL [ESP-0x1234567]
    // It is possible to simulate a CALL by doing a PUSH followed by RET,
    // so we check for a RET just prior to the return address
       or ((CodeDWORD4 and $FF000000) = $C3000000);// PUSH XX, RET

    // Because we're not doing a complete disassembly, we will potentially report
    // false positives. If there is odd code that uses the CALL 16:32 format, we
    // can also get false negatives.

  end;
end;

function NextStackFrame(var StackFrame: PStackFrame;
                        var StackInfo : TStackInfo): boolean;
begin
  // Only report this stack frame into the StockInfo structure
  // if the StackFrame pointer, EBP on the stack and return
  // address on the stack are valid addresses
  while ValidStackAddr(DWORD(StackFrame)) do
  begin
    // CallerAdr within current process space, code segment etc.
    if ValidCodeAddr(StackFrame^.CallerAdr) then
    begin
      Inc(StackInfo.Level);
      StackInfo.StackFrame := StackFrame;
      StackInfo.ParamPtr   := PDWORDS(DWORD(StackFrame) + SizeOf(TStackFrame));
      StackInfo.CallersEBP := StackFrame^.CallersEBP;
      StackInfo.CallerAdr  := StackFrame^.CallerAdr;
      StackInfo.DumpSize   := StackFrame^.CallersEBP - DWORD(StackFrame);
      StackInfo.ParamSize  := (StackInfo.DumpSize - SizeOf(TStackFrame)) div 4;
      // Step to the next stack frame by following the EBP pointer
      StackFrame           := PStackFrame(StackFrame^.CallersEBP);
      Result := true;
      Exit;
    end;
    // Step to the next stack frame by following the EBP pointer
    StackFrame := PStackFrame(StackFrame^.CallersEBP);
  end;
  Result := false;
end;

{$W+} // We must have stack-frames on for this routine

procedure TraceStackFrames(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
var
  StackFrame : PStackFrame;
  StackInfo  : TStackInfo;
begin
  // Start at level 0
  StackInfo.Level := 0;

  // Make sure the global variables are correctly set
  InitGlobalVars;

  // Get the current stack fram from the EBP register
  StackFrame := GetEBP;

  // We define the bottom of the valid stack to be the current EBP Pointer
  // There is a TIB field called pvStackUserBase, but this includes more of the
  // stack than what would define valid stack frames.
  BaseOfStack := DWORD(StackFrame) - 1;

  // Loop over and report all valid stackframes
  while NextStackFrame(StackFrame, StackInfo) and
        ReportStackFrame(StackInfo, PrivateData) do
    {Loop};
end;

procedure TraceStackRaw(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
var
  StackInfo : TStackInfo;
  StackPtr : PDWORD;
  PrevCaller: DWORD;
begin
  // We define the bottom of the valid stack to be the current ESP pointer
  BaseOfStack := DWORD(GetESP);

  // We will not be able to fill in all the fields in the StackInfo record,
  // so just blank it all out first
  FillChar(StackInfo, SizeOf(StackInfo), 0);

  // Make sure the global variables are correctly set
  InitGlobalVars;

  // Clear the previous call address
  PrevCaller := 0;

  // Get a pointer to the current bottom of the stack
  StackPtr := PDWORD(BaseOfStack);

  // Loop through all of the valid stack space
  while DWORD(StackPtr) < TopOfStack do
  begin

    // If the current DWORD on the stack,
    // refers to a valid call site...
    if ValidCallSite(StackPtr^) and (StackPtr^ <> PrevCaller) then
    begin
      // then pick up the callers address
      StackInfo.CallerAdr := StackPtr^;

      // remeber to callers address so that we don't report it repeatedly
      PrevCaller := StackPtr^;

      // increase the stack level
      Inc(StackInfo.Level);

      // then report it back to our caller
      if not ReportStackFrame(StackInfo, PrivateData) then
        Break;
    end;

    // Look at the next DWORD on the stack
    Inc(StackPtr);
  end;
end;

function DefaultReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
begin
  Result := (StackDumpCount < MaxStackLevels-1);
  if Result                                 and  // We have an available slot
     (DWORD(PrivateData) < StackInfo.Level) then // We're not going to skip this level
  begin
    // Save the contents of this stack frame
    StackDump[StackDumpCount] := StackInfo;
    Inc(StackDumpCount);
  end;
end;

procedure SaveStackTrace(Raw: boolean; IgnoreLevels: integer; FirstCaller: pointer);
begin
  FillChar(StackDump, SizeOf(StackDump), 0);
  StackDumpCount := 0;
  // Fill the first slot, if we are given an address directly
  if Assigned(FirstCaller) then
  begin
    StackDump[0].CallerAdr := DWORD(FirstCaller);
    StackDumpCount := 1;
  end;
  if Raw
  then TraceStackRaw   (DefaultReportStackFrame, Pointer(IgnoreLevels))
  else TraceStackFrames(DefaultReportStackFrame, Pointer(IgnoreLevels));
end;

const
  LinkerOffset = $1000;

function PhysicalToLogical(Physical: DWORD): DWORD;
begin
  Result :=   Physical
            - DWORD(HInstance)
            - LinkerOffset;
end;

end.